VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsConnection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'*---------------------------------------------------------------
'*
'* ClassName:      clsConnection
'* FileName:       CONNECTION.CLS
'* Date:           July 1998
'* Author:         Ian M. Weatherburn
'* Company:        Mindkey Software Solutions (Pty) Ltd.
'* Copyright:      Copyright (C) 1998 by Mindkey Software Solutions
'*                 All Rights Reserved
'* Description:    RAS Connection
'*
'*---------------------------------------------------------------

Option Explicit

' Protected variables for Connection Class
Private intIndex As Integer
Private lnghRASConn As Long
Private strEntryName As String
Private lngRASConnState As Long
Private strDeviceType As String
Private strDeviceName As String
Private strPhoneNumber As String
Private strCallbackNumber As String
Private strUserName As String
Private strDomain As String
Private strPassword As String
Private strWorkstationName As String
Private strIPXAddress As String
Private strIPAddress As String
Private bytLANA As Byte

Public Property Get hRASConn() As Long
  hRASConn = lnghRASConn
End Property

Public Property Let hRASConn(hNewRASConn As Long)
  Dim lngRetCode As Long
  
  If blnAllowUpdate Then
    lnghRASConn = hNewRASConn
    ' These are both extraneous so if they fail I just ignore them
    lngRetCode = fnRASGetConnectionStatus()
    lngRetCode = fnRASGetProjectionInfo()
  Else
    lngRASErrorNumber = 1111
    strRASErrorMessage = "Property not updateable"
    Err.Raise vbObjectError + 1111, _
              "Property not updateable", _
              "RAS Failure"
  End If
End Property

Public Property Get EntryName() As String
  EntryName = strEntryName
End Property

Public Property Let EntryName(strNewEntryName As String)
  Dim lngRetCode As Long
  
  If blnAllowUpdate Then
    strEntryName = strNewEntryName
    If lngRetCode Then
      Err.Raise vbObjectError + lngRetCode, _
                "EntryName Set Failed", _
                "RAS Failure"
    End If
  Else
    lngRASErrorNumber = 1111
    strRASErrorMessage = "Property not updateable"
    Err.Raise vbObjectError + 1111, _
              "Property not updateable", _
              "RAS Failure"
  End If
End Property

Public Property Get Index() As Integer
  Index = intIndex
End Property

Public Property Let Index(intNewIndex As Integer)
  If blnAllowUpdate Then
    intIndex = intNewIndex
  Else
    lngRASErrorNumber = 1111
    strRASErrorMessage = "Property not updateable"
    Err.Raise vbObjectError + 1111, _
              "Property not updateable", _
              "RAS Failure"
  End If
End Property

Public Property Get State() As Long
  State = lngRASConnState
End Property

Public Property Get DeviceName() As String
  DeviceName = strDeviceName
End Property

Public Property Get WorkstationName() As String
  WorkstationName = strWorkstationName
End Property

Public Property Get IPXAddress() As String
  IPXAddress = strIPXAddress
End Property

Public Property Get IPAddress() As String
  IPAddress = strIPAddress
End Property

Private Function fnRASGetConnectionStatus() As Long
  Dim lngRetCode As Long
  
  If lngWindowVersion = VER_PLATFORM_WIN32_NT Then
    ' We are using Microsoft NT
    Dim lpRASConnStatus As RASConnStatus
    
    lpRASConnStatus.dwSize = 64
    lngRetCode = RasGetConnectStatus(lnghRASConn, lpRASConnStatus)
    
    If lngRetCode Then
      strDeviceName = "Not Available"
      strDeviceType = "Not Available"
      lngRASErrorNumber = lngRetCode
      strRASErrorMessage = lpRASError.fnRASErrorMessage()
      fnRASGetConnectionStatus = lngRetCode
    Else
      ' Success
      lngRASConnState = lpRASConnStatus.RASConnState
      strDeviceName = fnTrimNulls(StrConv(lpRASConnStatus.szDeviceName(), vbUnicode))
      strDeviceType = fnTrimNulls(StrConv(lpRASConnStatus.szDeviceType(), vbUnicode))
      fnRASGetConnectionStatus = 0
    End If
  Else
    ' We are using Microsoft Windows 95
    Dim lpRASConnStatus95 As RASConnStatus95
    
    lpRASConnStatus.dwSize = 160
    lngRetCode = RasGetConnectStatus(lnghRASConn, lpRASConnStatus95)
    
    If lngRetCode Then
      strDeviceName = "Not Available"
      strDeviceType = "Not Available"
      lngRASErrorNumber = lngRetCode
      strRASErrorMessage = lpRASError.fnRASErrorMessage()
      fnRASGetConnectionStatus = lngRetCode
    Else
      ' Success
      lngRASConnState = lpRASConnStatus95.RASConnState
      strDeviceName = fnTrimNulls(StrConv(lpRASConnStatus95.szDeviceName(), vbUnicode))
      strDeviceType = fnTrimNulls(StrConv(lpRASConnStatus95.szDeviceType(), vbUnicode))
      fnRASGetConnectionStatus = 0
    End If
  End If
End Function

Private Function fnRASGetProjectionInfo() As Long
  Dim lngRetCode As Long
  Dim lpRASAMB As RASAMB
  Dim lpRASPPPNBF As RASPPPNBF
  Dim lpRASPPPIPX As RASPPPIPX
  Dim lpRASPPPIP As RASPPPIP
  Dim lpcb As Long
  Dim RASProjection As Long
  
  ' This will only work for PPP connections
  
  ' Start with RASAMB
  RASProjection = RASP_Amb
  lpRASAMB.dwSize = 28
  lpcb = 28
  
  lngRetCode = RasGetProjectionInfo(lnghRASConn, _
                                    RASProjection, _
                                    lpRASAMB, _
                                    lpcb)
  
  If lngRetCode Then
    bytLANA = 0
    lngRASErrorNumber = lngRetCode
    strRASErrorMessage = lpRASError.fnRASErrorMessage()
    fnRASGetProjectionInfo = lngRetCode
  Else
    bytLANA = lpRASAMB.bLana
    fnRASGetProjectionInfo = 0
  End If
  
  
  ' Net BIOS
  RASProjection = RASP_PppNbf
  lpRASAMB.dwSize = 48
  lpcb = 48
  
  lngRetCode = RasGetProjectionInfo(lnghRASConn, _
                                    RASProjection, _
                                    lpRASPPPNBF, _
                                    lpcb)
  
  If lngRetCode Then
    bytLANA = 0
    strWorkstationName = "Not Available"
    lngRASErrorNumber = lngRetCode
    strRASErrorMessage = lpRASError.fnRASErrorMessage()
    fnRASGetProjectionInfo = lngRetCode
  Else
    bytLANA = lpRASPPPNBF.bLana
    strWorkstationName = fnTrimNulls(StrConv(lpRASPPPNBF.szWorkstationName, vbUnicode))
    fnRASGetProjectionInfo = 0
  End If
  
  
  ' IPX
  RASProjection = RASP_PppIpx
  lpRASAMB.dwSize = 32
  lpcb = 32
  
  lngRetCode = RasGetProjectionInfo(lnghRASConn, _
                                    RASProjection, _
                                    lpRASPPPIPX, _
                                    lpcb)
  
  If lngRetCode Then
    bytLANA = 0
    strIPXAddress = "Not Available"
    lngRASErrorNumber = lngRetCode
    strRASErrorMessage = lpRASError.fnRASErrorMessage()
    fnRASGetProjectionInfo = lngRetCode
  Else
    strIPXAddress = fnTrimNulls(StrConv(lpRASPPPIPX.szIpxAddress, vbUnicode))
    fnRASGetProjectionInfo = 0
  End If
  
  
  ' TCP/IP
  RASProjection = RASP_PppIp
  lpRASAMB.dwSize = 40
  lpcb = 40
  
  lngRetCode = RasGetProjectionInfo(lnghRASConn, _
                                    RASProjection, _
                                    lpRASPPPIP, _
                                    lpcb)
  
  If lngRetCode Then
    bytLANA = 0
    strIPAddress = "Not Available"
    lngRASErrorNumber = lngRetCode
    strRASErrorMessage = lpRASError.fnRASErrorMessage()
    fnRASGetProjectionInfo = lngRetCode
  Else
    strIPAddress = fnTrimNulls(StrConv(lpRASPPPIP.szIPAddress, vbUnicode))
    fnRASGetProjectionInfo = 0
  End If
End Function

'*---------------------------------------------------------------
'* EOF: clsConnection
'*---------------------------------------------------------------

